home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-01 / cuj9205.zip / 1005018A < prev    next >
Text File  |  1992-06-02  |  1KB  |  70 lines
  1.  
  2. Listing 5 -- xdtento.c
  3.  
  4.  
  5. /* _Dtento function -- IEEE 754 version */
  6. #include <errno.h>
  7. #include <float.h>
  8. #include "xmath.h"
  9.  
  10.         /* macros */
  11. #define NPOWS    (sizeof pows / sizeof pows[0] - 1)
  12.         /* static data */
  13. static const double pows[] = {
  14.     1e1, 1e2, 1e4, 1e8, 1e16, 1e32,
  15. #if 0x100 < _DBIAS    /* assume IEEE 754 8-byte */
  16.     1e64, 1e128, 1e256,
  17. #endif
  18.     };
  19. static const size_t npows = NPOWS;
  20.  
  21. static short dmul(double *px, double y)
  22.     {    /* multiply y by *px with checking */
  23.     short xexp;
  24.  
  25.     _Dunscale(&xexp, px);
  26.     *px *= y;
  27.     return (_Dscale(px, xexp));
  28.     }
  29.  
  30. double _Dtento(double x, short n)
  31.     {    /* compute x * 10**n */
  32.     double factor;
  33.     short errx;
  34.     size_t i;
  35.  
  36.     if (n == 0 || x == 0.0)
  37.         return (x);
  38.     factor = 1.0;
  39.     if (n < 0)
  40.         {    /* scale down */
  41.         unsigned int nu = -(unsigned int)n;
  42.  
  43.         for (i = 0; 0 < nu && i < npows; nu >>= 1, ++i)
  44.             if (nu & 1)
  45.                 factor *= pows[i];
  46.         errx = dmul(&x, 1.0 / factor);
  47.         if (errx < 0 && 0 < nu)
  48.             for (factor = 1.0 / pows[npows]; 0 < nu; --nu)
  49.                 if (0 <= (errx = dmul(&x, factor)))
  50.                     break;
  51.         }
  52.     else if (0 < n)
  53.         {    /* scale up */
  54.         for (i = 0; 0 < n && i < npows; n >>= 1, ++i)
  55.             if (n & 1)
  56.                 factor *= pows[i];
  57.         errx = dmul(&x, factor);
  58.         if (errx < 0 && 0 < n)
  59.             for (factor = pows[npows]; 0 < n; --n)
  60.                 if (0 <= (errx = dmul(&x, factor)))
  61.                     break;
  62.         }
  63.     if (0 <= errx)
  64.         errno = ERANGE;
  65.     return (x);
  66.     }
  67.  
  68.  
  69.  
  70.